home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
001-025
/
scopedisk6
/
atoolsm2
/
atoolimp
< prev
next >
Wrap
Text File
|
1995-03-18
|
34KB
|
885 lines
IMPLEMENTATION MODULE AudioTools; (* BASED ON AUDIOTOOLS RELEASE.3 by Rob Peck*)
(* adapted to M2Amiga Modula-2 by Anthony Bryant*)
FROM SYSTEM IMPORT
ADDRESS,ADR,BYTE,LONGSET;
FROM Audio IMPORT
free, perVol, allocate, (* ADCMD_ commands *)
pervol, syncCycle, noWait, writeMessage, (* ADIOF_ flags *)
IOAudio;
FROM Dos IMPORT
Delay;
FROM Exec IMPORT
invalid,reset,read,write,update,clear,stop,start,flush, (* IOAudio cmds *)
quick, (* IOF_ flags *)
IORequest, Message, MsgPortPtr, Node, TaskPtr, UnitPtr, DevicePtr,
UByte, Byte, MemReqs, MemReqSet,
AllocMem, CloseDevice, FindTask, FreeMem, GetMsg, OpenDevice,
PutMsg, WaitIO, WaitPort;
FROM ExecSupport IMPORT
BeginIO, CreatePort, DeletePort;
CONST
waveSize=512; (* byte size of allocated memory for waves ONLY *)
TYPE
auMsg=RECORD
message: Message;
identifier: LONGINT; (* matches the bottom of ExtIOB *)
END;
auMsgPtr=POINTER TO auMsg;
VAR
unit: ARRAY [0..maxChan-1] OF UnitPtr; (* global pointers to Units *)
key: ARRAY [0..maxChan-1] OF INTEGER; (* global value for alloc keys *)
usertask: ARRAY [0..maxChan-1] OF TaskPtr; (* user owns which channels *)
(* in preparation for making this a shared library (loadable from disk) *)
openIOB: IOAudio; (* IOB to open and close the device *)
device: DevicePtr; (* global pointer to audio device *)
controlPort: MsgPortPtr; (* Port for ControlChannel functions *)
audbuffer: ARRAY [0..audBuffers-1] OF ExtIOB; (* global, static buffers *)
inuse: ARRAY [0..audBuffers-1] OF BOOLEAN; (* keep track of statics used *)
chipaudio: ARRAY [0..maxChan-1] OF ADDRESS; (* pntrs to waves in CHIP RAM *)
datalength: ARRAY [0..maxChan-1] OF LONGINT; (* length of data in CHIP RAM *)
replyPort: ARRAY [0..maxChan-1] OF MsgPortPtr; (* one ReplyPort per chan *)
dynamix: ARRAY [0..maxChan-1] OF LONGINT; (* keep track of dynamics used *)
anychan: ARRAY [0..maxChan-1] OF UByte; (* channel masks for mono *)
dynamicName: ADDRESS; (* "dynamic" IOB's *)
globalName: ADDRESS; (* "global" ( really "static") IOB's *)
(* Each waveform buffer contains 8 octaves of the wave. *)
woffsets: ARRAY [0..8] OF CARDINAL; (* where waveform for that octave begins. *)
wlen: ARRAY [0..8] OF CARDINAL; (* length of each waveform within a buffer *)
perval: ARRAY [0..12] OF CARDINAL; (* Period of these notes within an octave. *)
(*------------------- internal procedures ------------------------*)
(* FreeIOB - free a global (really static) or a dynamic, allocated IOB *)
PROCEDURE FreeIOB(iob: ExtIOBPtr; channel: LONGINT);
VAR
i: CARDINAL;
BEGIN
IF (iob^.request.message.node.name = dynamicName) THEN
FreeMem(iob, SIZE(iob^));
IF (dynamix[channel] # 0) THEN
DEC(dynamix[channel]); (* subtract one if nonzero *)
END;
ELSIF (iob^.request.message.node.name = globalName) THEN
i:= iob^.request.message.length;
IF (i < audBuffers) THEN
inuse[i]:= FALSE; (* frees this one for reuse *)
END;
END;
END FreeIOB;
(* ReEmployIOB - look at ALL of the reply ports and if any IOBs
* hanging around with nothing to do, then free them.
*
* Audio may still be playing the waveform as we get a message
* through MayGetNote. MayGetNote marks the iob message block as free-able,
* (when it finds that the identifier field is set to zero) but we have
* to have a way of recirculating in this list of messages.
*
* In other words, if something is free-able, free it, otherwise leave it
* on the list. So rather than removing things from the front of the list,
* lets just walk through the message list, remove (dequeue) what is
* freeable and leave the rest there to look at the next time.
*)
PROCEDURE ReEmployIOB();
VAR
i: LONGINT;
mp: MsgPortPtr;
iob: ExtIOBPtr;
pushback: ExtIOBPtr;
(* What happens here is that iob's are removed from the message port
* when they come back from the audio device. If YOU have set the
* messageport nonzero, it means that you wanted to know when
* this note began to play. The WriteMsg part of the iob is then
* linked, as a message, onto your user port. So this routine
* cannot free the iob until it is certain that YOU have finished
* using it. The iob_Priority field is READ here. If it still
* nonzero, the iob is pushed back onto the message port (on the
* end of the message queue) to be read again. We hold a pointer
* named "pushback" that lets us keep track of when we see that
* again. If we see it twice, it means we have completed a full
* circle through the queue of messages and have freed everything
* that we can this time. Therefore, we examine it and either
* free it or push it back again, then exit.
*)
BEGIN
FOR i:=0 TO maxChan-1 BY 1 DO
(* remove all iob's from ALL ports, unless we have to push one back *)
mp:= replyPort[i];
pushback:= NIL; (* nothing pushed back so far *)
iob:= ExtIOBPtr(GetMsg(mp));
WHILE (iob # NIL) DO
(* First see if messageport in writeMsg is not NIL; *)
(* if so, audio device is done, but user has not acknowledged *)
(* this message yet (by using MayGetNote). *)
IF (iob^.writeMsg.replyPort # NIL) THEN
PutMsg(mp, iob);
IF ((iob # pushback) AND (pushback = NIL)) THEN
pushback:= iob; (* Remember FIRST one pushed back *)
END;
ELSE
FreeIOB(iob,i); (* messageport is NIL, can free the iob *)
END;
iob:= ExtIOBPtr(GetMsg(mp));
END;
END;
END ReEmployIOB;
(* GetIOB - allocate an IOB , global (really static) or dynamic for use. *)
PROCEDURE GetIOB(channel: LONGINT): ExtIOBPtr;
VAR
i, usereply: CARDINAL;
iob: ExtIOBPtr; (* in case we need to allocate one *)
BEGIN
ReEmployIOB(); (* find already used ones and free them *)
IF (channel = -1) THEN usereply:= 0; ELSE usereply:= channel; END;
(* try to allocate a global (really static) iob to use *)
FOR i:=0 TO audBuffers-1 BY 1 DO
IF (inuse[i] = FALSE) THEN
(* we have our global (really static), so assign parameters *)
inuse[i]:= TRUE;
audbuffer[i].request.device:= device;
audbuffer[i].request.message.replyPort:= replyPort[usereply];
audbuffer[i].request.message.length:= i;
audbuffer[i].request.message.node.name:= globalName;
RETURN ADR(audbuffer[i]);
END;
END;
(* if all globals (really statics) are in use, try to allocate dynamic one *)
iob:= ExtIOBPtr(AllocMem(SIZE(iob^), MemReqSet{memClear}));
IF (iob = NIL) THEN RETURN NIL; END; (* out of memory *)
(* we have our dynamic, so assign parameters *)
iob^.request.device:= device;
iob^.request.message.replyPort:= replyPort[usereply];
iob^.request.message.node.name:= dynamicName;
iob^.request.message.length:= dynamix[usereply];
INC(dynamix[usereply]); (* add one to number allocated to a channel *)
RETURN iob;
END GetIOB;
(* CheckIOBDone - to see if all iob's are finished (i.e. freed up)
* if TRUE then everything IS finished.
*)
PROCEDURE CheckIOBDone(): BOOLEAN;
VAR
i, status: LONGINT;
BEGIN
status:= 0; (* means there are still some iob's in play *)
(* when status = 4, then everything is free *)
FOR i:=0 TO audBuffers-1 BY 1 DO
IF (inuse[i] = TRUE) THEN
(* Sooner or later, this will catch both
* the statics and dynamics. Note that
* this will only work if NO (REPEAT: NO)
* iob's sent off with a duration value
* of "0", because zero means "forever"
*)
ReEmployIOB();
END;
END;
(* Note to implementors... maintaining inuse[i] now seems
* like a lousy idea, unless it is accompanied by a variable
* statics_inplay that decrements to zero when all statics
* are done. That makes it much easier to check than going
* through all of the inuse[]'s. Maybe not.
*)
FOR i:=0 TO maxChan-1 BY 1 DO
IF (dynamix[i] > 0) THEN
(* If this channel still playing a *)
(* dynamically allocated block, wait *)
(* for all messages to return before *)
(* the program exits. *)
ReEmployIOB(); (* take another shot at freeing it all *)
END;
END;
FOR i:=0 TO maxChan-1 BY 1 DO (* Check again as we nearly exit *)
IF (dynamix[i] = 0) THEN INC(status); END;
END;
IF (status = 4) THEN (* All dynamics are free, now check the statics *)
FOR i:=0 TO audBuffers-1 BY 1 DO
IF (inuse[i] = TRUE) THEN RETURN FALSE; END; (* some not free *)
END;
RETURN TRUE; (* DONE! *)
ELSE
RETURN FALSE; (* still some out there! *)
END;
END CheckIOBDone;
(* -------------- USER support procedures ----------------- *)
(* InitAudio returns, uport, a pointer to a message port at which your task
* receives a message when a particular note BEGINS to play.
* You must save this value somewhere, and use it to call MayGetNote
* or FinishAudio. MayGetNote is the name of the routine that you call
* to check if a note has begun to play. If an error occurs (can't Opendevice
* or CreatePorts) then pointer = NIL
*)
PROCEDURE InitAudio(): MsgPortPtr;
VAR
error,i: LONGINT;
firstuser: BOOLEAN; (* THIS WILL GET MOVED when shared library is made *)
BEGIN
firstuser:= TRUE;
FOR i:=0 TO audBuffers-1 BY 1 DO
inuse[i]:= FALSE; (* declare all message blocks are available *)
END;
openIOB.length:= 0; (* Open device but don't allocate channels *)
OpenDevice(ADR("audio.device"),0,ADR(openIOB),LONGSET{0});
(* returns error in io_Error field; should be 0 *)
error:= LONGINT(openIOB.request.error); (* IOERR_OPENFAIL -1 *)
IF (error # 0) THEN RETURN NIL; END;
device:= openIOB.request.device; (* Get the device address for later use *)
FOR i:=0 TO maxChan-1 BY 1 DO
replyPort[i]:= CreatePort(0,0); (* ports for replies from each channel *)
IF (replyPort[i] = NIL) THEN RETURN NIL; END;
chipaudio[i]:= 0; (* have not yet created the waves/samples *)
datalength[i]:= 0; (* length of wave/sample data in CHIP RAM *)
dynamix[i]:= 0; (* no dynamic I/O blocks allocated *)
(* When implemented as a shared library, "firstuser" will only *)
(* be TRUE when the library is first opened. *)
IF (firstuser = TRUE) THEN
key[i]:= 0; (* init key values *)
unit[i]:= NIL; (* init unit values *)
usertask[i]:= NIL; (* no channel owned by any task *)
END;
END;
controlPort:= CreatePort(0,0); (* use for control & syncronous functions *)
IF (controlPort = NIL) THEN RETURN NIL; END;
(* init anychan ARRAY for use by GetChannel *)
anychan[0]:=1; anychan[1]:=2; anychan[2]:=4; anychan[3]:=8;
(* init waveform buffer offsets ARRAY for use by PlayNote *)
woffsets[0]:=0; woffsets[1]:=256; woffsets[2]:=384; woffsets[3]:=448;
woffsets[4]:=480; woffsets[5]:=496; woffsets[6]:=504; woffsets[7]:=508;
woffsets[8]:=510;
(* init length of each waveform in a buffer ARRAY *)
wlen[0]:=256; wlen[1]:=128; wlen[2]:=64; wlen[3]:=32; wlen[4]:=16;
wlen[5]:=8 ; wlen[6]:=4; wlen[7]:=2; wlen[8]:=1;
(* init period value to go with note within an octave *)
perval[0]:=428; perval[1]:=404; perval[2]:=381; perval[3]:=360;
perval[4]:=339; perval[5]:=320; perval[6]:=302; perval[7]:=285;
perval[8]:=269; perval[9]:=254; perval[10]:=240; perval[11]:=226;
perval[12]:=214;
dynamicName:= ADR("dynamic");
globalName := ADR("global");
RETURN CreatePort(0,0); (* my user port *)
END InitAudio;
(*---------------- USER support procedures ----------------- *)
(* GetChannel: To request "any" channel, use channel = -1;
* To request a specific channel, use channel = 0, 1, 2 or 3;
* Again NOTE, this returns two globals as well as the channel number!
*)
PROCEDURE GetChannel(channel: LONGINT): LONGINT;
VAR
error, channum: LONGINT;
addrmsg: ADDRESS;
iob: ExtIOBPtr;
controlIOB: ExtIOB;
BEGIN
iob:= ADR(controlIOB);
iob^.request.device:= device;
iob^.request.message.replyPort:= controlPort;
iob^.allocKey:= 0; (* zero for new key *)
iob^.request.message.node.pri:= 20;
IF (channel = -1) THEN
iob^.data:= ADR(anychan[0]);
iob^.length:= 4;
ELSIF ((channel >=0) AND (channel < maxChan)) THEN
(* NOTE ***** ENHANCEMENT COMING HERE ***** *)
IF (usertask[channel] # NIL) THEN RETURN (notYourChannel); END;
(* Enhancement might be: look at the running priority
* of the current task as compared to the running priority
* of the task in usertask[i]. If not same task and if
* the current task has a higher priority, STEAL the channel!
* Alternative (seems better) is to have a global variable
* called audPriority to be set by a new function SetAudPriority
* (for a given task only), and that global priority value
* would be used for GetChannel and LockChannel requests.
*)
iob^.data:= ADR(anychan[channel]);
iob^.length:= 1;
ELSE (* chose a bad channel number; cannot allocate it *)
RETURN (badChannelSelected);
END;
iob^.request.command:= allocate; (* ADCMD_ALLOCATE *)
iob^.request.flags:= noWait + quick; (* ADIOF_NOWAIT | IOF_QUICK *)
BeginIO(iob);
WaitIO(iob); (* returns error in io_Error field; should be 0 *)
error:= LONGINT(iob^.request.error); (* ADIOERR_NOALLOCATION -10 *)
IF (error # 0) THEN RETURN error; END;
(* WaitIO, just above, removes the message from the port. No need of GetMsg *)
CASE LONGINT(iob^.request.unit) OF
1 : channum:= 0; |
2 : channum:= 1; |
4 : channum:= 2; |
8 : channum:= 3;
ELSE
RETURN (badChannelSelected);
END;
unit[channum]:= iob^.request.unit;
key[channum]:= iob^.allocKey;
usertask[channum]:= FindTask(0); (* THIS user task owns it now *)
RETURN channum; (* valid channel number (0-3) *)
END GetChannel;
(* Use IsThatMyChan to determine if you (still) own a particular channel.
* The audio device has an arrangement by which a higher priority request
* for a channel than the one that already owns it can be made. The higher
* priority request can actually cause a channel to be stolen from a user.
* This feature may be implemented in a future version of audiotools,
* (shared library version), in which, depending on the task's running
* priority itself, a higher priority task could succeed at GetChannel
* for a channel that is already owned by another task.
*)
PROCEDURE IsThatMyChan(channel: LONGINT): LONGINT;
BEGIN
IF ((channel < 0) OR (channel > maxChan-1)) THEN RETURN (badChannelSelected);
ELSIF (usertask[channel] # FindTask(0)) THEN RETURN (notYourChannel); END;
RETURN 0; (* if YOU still own the channel *)
END IsThatMyChan;
(* ------------------ internal procedure use only -------------------- *)
PROCEDURE ControlChannel(channel: LONGINT; command: CARDINAL): LONGINT;
VAR
error: LONGINT;
iob: ExtIOBPtr;
controlIOB: ExtIOB;
BEGIN
error:= IsThatMyChan(channel);
IF (error # 0) THEN RETURN error; END;
iob:= ADR(controlIOB);
iob^.request.device:= device;
iob^.request.message.replyPort:= controlPort;
iob^.request.unit:= unit[channel];
iob^.allocKey:= key[channel];
iob^.request.command:= command; (* CMD_xxxxx *)
IF (command = free) THEN
iob^.request.flags:= noWait + quick; (* ADIOF_NOWAIT | IOF_QUICK *)
ELSE
iob^.request.flags:= quick; (* IOF_QUICK *)
END;
BeginIO(iob);
WaitIO(iob); (* returns error in io_Error field; should be 0 *)
error:= LONGINT(iob^.request.error); (* ADIOERR_NOALLOCATION -10 *)
RETURN error;
END ControlChannel;
(* ----------------- USER support procedures -------------------- *)
PROCEDURE StartChannel(channel: LONGINT): LONGINT;
BEGIN
RETURN ControlChannel(channel, start);
END StartChannel;
PROCEDURE StopChannel(channel: LONGINT): LONGINT;
BEGIN
RETURN ControlChannel(channel, stop);
END StopChannel;
PROCEDURE ResetChannel(channel: LONGINT): LONGINT;
BEGIN
RETURN ControlChannel(channel, reset);
END ResetChannel;
PROCEDURE FlushChannel(channel: LONGINT): LONGINT;
BEGIN
RETURN ControlChannel(channel, flush);
END FlushChannel;
PROCEDURE FreeChannel(channel: LONGINT): LONGINT;
VAR
error: LONGINT;
BEGIN
error:= ControlChannel(channel, free);
IF (error # 0) THEN RETURN error; END;
usertask[channel]:= NIL; (* free again... *)
RETURN 0; (* everything o.k *)
END FreeChannel;
(* CheckIfDone - to see if everything is finished BEFORE calling FinishAudio *)
PROCEDURE CheckIfDone(): BOOLEAN;
BEGIN
RETURN CheckIOBDone();
END CheckIfDone;
(* Set Period and Volume of a note that is playing. *)
PROCEDURE SetPV(channel: LONGINT; period, volume: CARDINAL): LONGINT;
VAR
error: LONGINT;
iob: ExtIOBPtr;
controlIOB: ExtIOB;
BEGIN
error:= IsThatMyChan(channel);
IF (error # 0) THEN RETURN error; END;
iob:= ADR(controlIOB);
iob^.request.device:= device;
iob^.request.message.replyPort:= controlPort;
iob^.request.unit:= unit[channel];
iob^.allocKey:= key[channel];
iob^.period:= period; (* new period *)
iob^.volume:= volume; (* new volume *)
iob^.request.command:= perVol; (* ADCMD_PERVOL *)
iob^.request.flags:= quick + pervol; (* IOF_QUICK | ADIOF_PERVOL *)
BeginIO(iob); (* This one will be synchronous; *)
(* affects whatever is playing on this channel at this time. *)
WaitIO(iob); (* OK to wait, since it will return *)
error:= LONGINT(iob^.request.error); (* ADIOERR_NOALLOCATION -10 *)
RETURN error; (* error in io_Error field; should be 0 *)
END SetPV;
(* SetWave creates CHIP RAM, if neccassary (only once per channel)
* and copies to CHIP RAM (with expand wave) users ARRAY [0..255] OF BYTE,
* where each element in ARRAY must be in the range -128 to 127 since
* audio DMA retrieves one word (16 bits) at a time and reads two bytes
*)
PROCEDURE SetWave(channel: LONGINT;
VAR waveform: ARRAY OF BYTE): LONGINT;
VAR
error: LONGINT;
i, j, rate: CARDINAL;
tmptr: ADDRESS; (* where ADDRESS = POINTER TO BYTE *)
BEGIN
error:= IsThatMyChan(channel);
IF (error # 0) THEN RETURN error; END;
IF (chipaudio[channel] # 0) THEN (* not first time *)
IF (datalength[channel] # waveSize) THEN (* must be sample *)
FreeMem(chipaudio[channel], datalength[channel]);
chipaudio[channel]:= 0; datalength[channel]:= 0;
END;
END;
IF (chipaudio[channel] = 0) THEN (* only allocate if neccessay! *)
chipaudio[channel]:= AllocMem(waveSize, MemReqSet{chip, memClear});
IF (chipaudio[channel] = 0) THEN RETURN (outOfMemory); END;
datalength[channel]:= waveSize; (* for use by FreeMem *)
END;
(* ok so far, now copy array to CHIP RAM (with expand wave) *)
tmptr:= chipaudio[channel];
rate:= 1;
FOR i:= 0 TO 8 BY 1 DO
j:= 0;
REPEAT (* replicate waves in decreasing sample sizes *)
tmptr^:= waveform[j]; INC(tmptr); (* increment address *)
j:= j + rate;
UNTIL j > 255;
rate:= rate * 2;
END;
RETURN 0; (* O.K. *)
END SetWave;
(* SetSamp creates CHIP RAM, if neccassary (only once per channel)
* unless "length"= 0 which just frees up existing sample CHIP RAM or...
* copies byte by byte from users supplied "sampleaudio" to CHIP RAM,
* unless "sampleaudio"= 0 which just creates CHIP RAM (without copying)
* and returns new "sampleaudio" to user, (useful if samples loaded from disk)
* Note each element in "sampleaudio" must be in the range -128 to 127 since
* audio DMA retrieves one word (16 bits) at a time and reads two bytes
*)
PROCEDURE SetSamp(channel: LONGINT;
VAR sampleaudio: ADDRESS; (* returns new address *)
length: LONGINT): LONGINT;
VAR
error: LONGINT;
j: LONGINT;
chiptr, samptr: ADDRESS; (* where ADDRESS = POINTER TO BYTE *)
BEGIN
error:= IsThatMyChan(channel);
IF (error # 0) THEN RETURN error; END;
IF (chipaudio[channel] # 0) THEN (* free up old mem *)
FreeMem(chipaudio[channel], datalength[channel]);
chipaudio[channel]:= 0; datalength[channel]:= 0;
END;
IF (length = 0) THEN RETURN 0; END; (* just free up old mem *)
IF (length > 131072) THEN length:= 131072; END; (* limit length *)
IF (chipaudio[channel] = 0) THEN (* only allocate once per channel! *)
chipaudio[channel]:= AllocMem(length, MemReqSet{chip, memClear});
IF (chipaudio[channel] = 0) THEN RETURN (outOfMemory); END;
datalength[channel]:= length; (* for use by FreeMem *)
END;
IF (sampleaudio = 0) THEN sampleaudio:= chipaudio[channel]; RETURN 0; END;
(* ok so far, length and sampleaudio nonzero, now copy to CHIP RAM *)
chiptr:= chipaudio[channel];
samptr:= sampleaudio;
FOR j:= 1 TO length BY 1 DO
chiptr^:= samptr^; INC(chiptr); INC(samptr); (* increment address *)
END;
RETURN 0; (* O.K. *)
END SetSamp;
(* -------------- internal procedure use only ------------------*)
PROCEDURE PlayXXXX(channel: LONGINT;
wfptr: ADDRESS; (* pointer to waveform in CHIP RAM *)
len: LONGCARD;
per: CARDINAL;
vol: CARDINAL;
cycles: CARDINAL;
priority: Byte;
messageport: MsgPortPtr;
id: LONGINT): LONGINT;
VAR
error: LONGINT;
iob: ExtIOBPtr;
BEGIN
iob:= GetIOB(channel);
IF (iob # NIL) THEN (* set the parameters *)
iob^.request.unit:= unit[channel];
iob^.allocKey:= key[channel];
iob^.data:= wfptr;
iob^.length:= len;
iob^.period:= per;
iob^.volume:= vol;
iob^.cycles:= cycles;
iob^.request.message.node.pri:= priority;
iob^.identifier:= id; (* for support of tell-me-when-note-starts *)
iob^.request.command:= write; (* CMD_WRITE *)
iob^.request.flags:= pervol; (* ADIOF_PERVOL *)
(* Initialize message port. If NIL, then no pushing back of a message.
* If nonzero, message gets recirculated by ReEmployIOB until
* the user finally acknowledges it by using MayGetNote. *)
iob^.writeMsg.replyPort:= messageport;
IF (messageport # NIL) THEN
(* "reply" to this message - ADIOF_WRITEMESSAGE *)
iob^.request.flags:= iob^.request.flags + writeMessage;
END;
BeginIO(iob);
RETURN 0; (* all went ok *)
END;
RETURN (outOfMemory); (* (else-part) iob was zero, couldn't do the above. *)
END PlayXXXX;
(* PlayNote - starts a sound on the channel with specified period and volume.
* This nice little routine takes a note and plays it on the given
* voice. The note is basically an integer from
* 0 to 11 (c to b) plus 12 per octave above the first and lowest,
* which yields a note range of 0 to 95.
* The waveform to use is determined by adding an index (woffsets[])
* dependant on the octave to waveform in chipaudio[channel] as setup by
* SetWave. The length of the waveform (in wlen[]) is likewise dependant
* on the octave. Note that octaves start with zero, not one.
* The period and volume can be modified later, using SetPV.
*)
PROCEDURE PlayNote(channel: LONGINT; (* specify channel number 0-3 *)
note: CARDINAL; (* specify note number 0-95 *)
volume: CARDINAL; (* volume 0-64 *)
duration: CARDINAL; (* duration 1000ths of a sec. *)
priority: Byte; (* force a range -128 to 127 *)
messageport: MsgPortPtr;
id: LONGINT);
VAR
error: LONGINT;
period, octave: CARDINAL;
ipart, jpart: CARDINAL;
length: LONGCARD;
wavepointer: ADDRESS; (* where to find start of waveform *)
cycles: CARDINAL;
BEGIN
error:= IsThatMyChan(channel);
IF (error # 0) THEN RETURN; END;
IF (note > 95) THEN note:= 95; END;
IF (volume > 64) THEN volume:=64; END;
octave:= note DIV 12;
IF (chipaudio[channel] = 0) THEN RETURN; END; (* no SetWave or SetSamp !! *)
wavepointer:= chipaudio[channel] + ADDRESS(woffsets[octave]);
length:= wlen[octave];
period:= perval[note MOD 12];
(* divide duration into two parts - ipart & jpart - for calculations *)
IF (duration > 1000) THEN ipart:= duration DIV 1000; ELSE ipart:=0; END;
jpart:= duration - (ipart * 1000);
(* fool it a little so we don't get integer overflow... *)
(* 3.5 million times 1000 is about all we can take in a 32 bit word *)
cycles:= ((LONGCARD(audClock) * ipart)+(LONGCARD(audClock) * jpart) DIV 1000)
DIV (LONGCARD(length) * period);
IF ((cycles = 0) AND (duration # 0)) THEN cycles:= 1; END;
error:= PlayXXXX(channel,wavepointer,length,period,volume,cycles,
priority,messageport,id);
RETURN (* just ignore error *)
END PlayNote;
(* PlayFreq - in this version is for scalar values of frequency only.
* Minimum value is 28Hz, practical maximum is about 7000Hz.
* Period is calculated from frequency to within 127 to 500, otherwise,
* if the frequency is out of range of what we have in our wave tables
* currently, we have to reject the command.
*)
PROCEDURE PlayFreq(channel: LONGINT; (* specify channel number 0-3 *)
freq: CARDINAL; (* specify scalar freq 28-7000 Hz *)
volume: CARDINAL; (* volume 0-64 *)
duration: CARDINAL; (* 1000ths of a second *)
priority: Byte; (* force a range -128 to 127 *)
messageport: MsgPortPtr; (* for use by MayGetNote *)
id: LONGINT);
VAR
error: LONGINT;
period, octave: CARDINAL;
ipart, jpart: CARDINAL;
length: LONGCARD;
wavepointer: ADDRESS; (* where to find start of waveform *)
cycles: CARDINAL;
i: CARDINAL;
accept: BOOLEAN;
BEGIN
error:= IsThatMyChan(channel);
IF (error # 0) THEN RETURN; END;
IF (freq = 0) THEN RETURN; END;
IF (volume > 64) THEN volume:= 64; END;
i:= 0; (* see if we CAN represent this frequency, if not, reject it *)
LOOP (* figure out which waveform to use... *)
octave:= i; (* start with the first wlen value because *)
accept:= FALSE; (* we want to use the longest waveform we can. *)
period:= LONGCARD(audClock) DIV (LONGCARD(freq) * (wlen[octave]));
IF (period > 500) THEN EXIT; END; (* freq less than 28Hz. *)
IF (period > 127) THEN accept:= TRUE; EXIT; END;
i:=i+1; IF (i > 8) THEN EXIT; END;
END;
IF (accept = FALSE) THEN RETURN; END; (* reject it *)
IF (chipaudio[channel] = 0) THEN RETURN; END; (* no SetWave or SetSamp !! *)
wavepointer:= chipaudio[channel] + ADDRESS(woffsets[octave]);
length:= wlen[octave];
(* divide duration into two parts - ipart & jpart - for calculations *)
IF (duration > 1000) THEN ipart:= duration DIV 1000; ELSE ipart:=0; END;
jpart:= duration - (ipart * 1000);
(* fool it a little so we don't get integer overflow... *)
(* 3.5 million times 1000 is about all we can take in a 32 bit word *)
cycles:= (LONGCARD(freq) * ipart) + (LONGCARD(freq) * jpart) DIV 1000;
IF ((cycles = 0) AND (duration # 0)) THEN cycles:= 1; END;
error:= PlayXXXX(channel,wavepointer,length,period,volume,cycles,
priority,messageport,id);
RETURN (* just ignore error *)
END PlayFreq;
(* MayGetNote - is used to synchronize the Play audio routines, using
* messageport and id, (parameters of the Play routines).
* where uport is the pointer to the port you received from InitAudio.
*
* when flag = FALSE, the routine returns immediately, with an id = 0
* (no id available), or the value of the first id to arrive at the port.
*
* when flag = TRUE, the routine will wait if (and only if) there is no id.
* In other words, you can cause your task to go to sleep until the
* next note begins to play. You decide what to do for a specific note.
*
* CAUTION - if there are no more notes with messageport nonzero in
* the queue and you specify TRUE for the flag, you can cause your
* task to sleep forever!!
*)
PROCEDURE MayGetNote(uport: MsgPortPtr; flag: BOOLEAN): LONGINT;
VAR
aum: auMsgPtr;
BEGIN
LOOP
aum:= auMsgPtr(GetMsg(uport)); (* is a message there? *)
IF (aum # NIL) THEN (* There was a message! *)
(* The user has seen this msg, so the system can deallocate
* the iob in which it occurs anytime in the future.
* Now that we have received the message at our own reply
* port, it belongs to us and we can do whatever we want
* to it. Set the reply port value to zero now, as a signal
* to FreeIOB that it can really do that!
*)
aum^.message.replyPort:= NIL;
EXIT; (* from LOOP with message *)
END;
IF (flag = TRUE) THEN
(* let caller sleep while waiting for any identified iob to appear. *)
WaitPort(uport); (* Note: WaitPort does NOT remove message from port *)
flag:= FALSE;
END;
END;
RETURN (aum^.identifier); (* return the LONG value *)
END MayGetNote;
(* PlaySamp - play a sampled sound:
* Identical to PlayFreq but the parameters are interpreted differently.
* "freq" now becomes "period" interpreted as sampling_rate,
* must be in the range of 127 to 500.
* "duration" still is expressed in 1000ths of a second to play it.
* (as with the audio device itself, a duration of 0 means do it forever
* or until the audio device is reset or the channel is flushed or
* until this command is explicitly aborted.)
*)
PROCEDURE PlaySamp(channel: LONGINT; (* specify channel number 0-3 *)
period: CARDINAL; (* period value 127 to 500 *)
volume: CARDINAL; (* volume 0-64 *)
duration: CARDINAL; (* 1000ths of a second *)
priority: Byte; (* force a range -128 to 127 *)
messageport: MsgPortPtr; (* for use by MayGetNote *)
id: LONGINT);
VAR
error: LONGINT;
wavepointer: ADDRESS; (* where to find start of sample to play *)
cycles: CARDINAL;
ipart, jpart: CARDINAL;
length: LONGCARD;
BEGIN
error:= IsThatMyChan(channel);
IF (error # 0) THEN RETURN; END;
IF (period > 500) THEN period:= 500; (* Note: or reject it ? *)
ELSIF (period < 127) THEN period:= 127; END;
IF (volume > 64) THEN volume:= 64; END;
IF (chipaudio[channel] = 0) THEN RETURN; END; (* no SetWave or SetSamp !! *)
wavepointer:= chipaudio[channel];
length:= datalength[channel]; (* as set by SetSamp *)
(* divide duration into two parts - ipart & jpart - for calculations *)
IF (duration > 1000) THEN ipart:= duration DIV 1000; ELSE ipart:=0; END;
jpart:= duration - (ipart * 1000);
(* fool it a little so we don't get integer overflow... *)
(* 3.5 million times 1000 is about all we can take in a 32 bit word *)
cycles:= ((LONGCARD(audClock) * ipart)+(LONGCARD(audClock) * jpart) DIV 1000)
DIV (LONGCARD(length) * period);
IF ((cycles = 0) AND (duration # 0)) THEN cycles:= 1; END;
error:= PlayXXXX(channel,wavepointer,length,period,volume,cycles,
priority,messageport,id);
RETURN (* just ignore error *)
END PlaySamp;
(* If the user says FinishAudio, IT MEANS FINISH AUDIO.
* Flush anything that is still in play, NOW. You can
* use "CheckIfDone()" to see if everything is finished
* BEFORE you call FinishAudio. If CheckIfDone() is
* (FALSE), it means that something is still playing.
*)
PROCEDURE FinishAudio(uport: MsgPortPtr);
VAR
error: LONGINT;
aum: auMsgPtr; (* A little bigger than a standard message, *)
i: LONGINT; (* but this routine will not really know *)
(* (or care) about the difference. *)
BEGIN
IF (uport # NIL) THEN
FOR i:=0 TO maxChan-1 BY 1 DO
error:= FlushChannel(i); (* error is dummy function return *)
END;
WHILE (CheckIOBDone() = FALSE) DO
Delay(12); (* Be a good multitasking neighbor: sleep a little *)
END;
aum:= auMsgPtr(GetMsg(uport)); (* prepare to empty the port *)
WHILE (aum # NIL) DO
aum^.message.replyPort:= NIL; (* let system deallocate it *)
aum:= auMsgPtr(GetMsg(uport));
END;
ReEmployIOB(); (* free all static and dynamic messages *)
FOR i:=0 TO maxChan-1 BY 1 DO
error:= FreeChannel(i); (* error is dummy function return *)
END;
DeletePort(uport);
END;
IF (device # NIL) THEN CloseDevice(ADR(openIOB)); END;
FOR i:=0 TO maxChan-1 BY 1 DO
IF (chipaudio[i] # 0) THEN
FreeMem(chipaudio[i], datalength[i]);
chipaudio[i]:= 0; datalength[i]:= 0;
END;
IF (replyPort[i] # NIL) THEN DeletePort(replyPort[i]); END;
END;
IF (controlPort # NIL) THEN DeletePort(controlPort); END;
END FinishAudio;
END AudioTools.imp